-- card: 37891 from stack: in.2r
-- bmap block id: 0
-- flags: 0000
-- background id: 14090
-- name: massCompact


-- part 1 (field)
-- low flags: 00
-- high flags: 0004
-- rect: left=120 top=90 right=218 bottom=399
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 0
-- font id: 3
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: desc


-- part 2 (button)
-- low flags: 00
-- high flags: A003
-- rect: left=191 top=231 right=260 bottom=336
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: Multiple Compact
----- HyperTalk script -----
function FolderPath name
--
-- FolderPath -- given a file pathname, returns whatever comes
-- before the last colon, if anything (should be a folder or disk name).
-- From Dewi Williams; modified by John Koch
--
-- scan backwards for the last colon.
repeat with i = the length of name down to 1
  if character i of name is ":" then exit repeat
end repeat
subtract 1 from i -- before the colon
-- Name was of the form "Thing:otherthing". Return "Thing".
put empty into lastpath
if i > 0 then put char 1 to i of name into lastpath
return lastpath
end FolderPath


on mouseUp
  --*****************************************************
  --*    MASS COMPACTER   by Brian D. McLean, D.D.S.    *
  --*                        CIS: 75026,3724            *
  --*                        GEnie: B.McLean            *
  --*                                                   *
  --*    Modified by John A. Koch   2/27/88             *
  --*                CIS: 72457,736                     *
  --*                                                   *
  --*    Modifications:                                 *
  --*      1. Uses FileName() XFCN to select folder.    *
  --*      2. Can only compact stack if userlevel is    *
  --*         greater than 2 since "Compact Stack" is   *
  --*         not in the menu at level 1 or 2.          *
  --*      3. Does not count space for a stack it       *
  --*         cannot compact.                           *
  --*                                                   *
  --*   uses the XFCN Files()    by Guy de Picciotto    *
  --*                               CIS: 73300,3637     *
  --*                               GENIE: G.PICCIOTO   *
  --*                                                   *
  --*   uses the XFCN FileName() by Steve Maller        *
  --*                               Apple Computer      *
  --*                               AppleLink: Maller1  *
  --*                               Delphi: stevemaller *
  --*                               MCI Mail: smaller   *
  --*****************************************************
  -- **** DON'T FORGET TO MOVE THE FILES() AND FILENAME() XFCNs SO
  -- THAT THEY WILL BE AVAILABLE TO THE SCRIPT.
  -- USE RESEDIT OR RESCOPY FOR THIS.
  if the optionkey is down then pass mouseup

  put the userlevel into Oldlevel
  put FileName("STAK") into compacterPath
  go to this card  -- redraws card
  --use the 2 lines below to create a default pathname if desired.
  --if compacterPath is empty then put "Mydisk:Lotsa Stacks" into --compacterPath
  if compacterPath is empty then
    exit to hypercard
  end if
  put FolderPath(compacterPath) into compacterPath
  if compacterPath is empty then
    answer "Problems with this folder name" with "Too bad"
    exit to hypercard
  end if
  Put Files(compacterPath,"STAK") into stacknames
  push card
  put zero into examined
  put zero into compacted
  put zero into saved
  set the cursor to 4  -- it is the watch
  set lockmessages to true
  set lockscreen to true
  repeat with x = 1 to number of lines of stacknames
    if the shiftKey is down then
      put "Checking halted" into msg
      set the userlevel to Oldlevel
      set lockmessages to false
      set lockscreen to false
      exit mouseup
    end if
    put line x of stacknames into thisstack
    put "Checking " & quote & thisstack & quote
    add one to examined
    put the freesize of stack thisstack into fsize
    put " -- Freesize is" && fsize after msg
    if fsize is zero then
      wait 30
    else
      go to stack thisstack
      set the userlevel to 3
      if the userlevel > 2 then
        put "Compacting" into first word of msg
        add fsize to saved
        doMenu "Compact Stack"
        add one to compacted
      end if
    end if
  end repeat
  pop card
  set lockmessages to false
  set lockscreen to false
  Put "All done!" && "Examined" && examined && "stacks; compacted" && compacted &&"to regain" && saved && "bytes."
  wait 3 seconds
  hide msg
  set the userlevel to Oldlevel
end mouseUp



-- part contents for background part 12
----- text -----
massCompact

-- part contents for card part 1
----- text -----
This button allows you to select a stack from a folder and automatically compacts all the stacks with wasted space in the same folder.  If you copy this button to another stack, you also need to install the Filename & Files XFCNs.

-- part contents for background part 5
----- text -----
8